home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 4 / Amoszine 4 (Disk 3 of 3).adf / EXTRA_SOURCE / Life.AMOS / Life.amosSourceCode
Encoding:
AMOS Source Code  |  1992-02-26  |  6.7 KB  |  248 lines
  1. ' *********************************************  
  2. ' *     AmigaLife - by Mike Richmond 1994     *  
  3. ' * Based on a "game" invented by John Conway *
  4. ' *    Adapted from a listing in the book     *
  5. ' *     "The Joy of Computers" (Not sex)      *  
  6. ' *         by Peter Laurie, 1983(!)          *
  7. ' *********************************************
  8. '
  9. ' Version 1.00 
  10. '
  11. '
  12. ' "Life" is not a game, as such, in that it plays itself.
  13. ' It is a computerised study of artificial intelligence, and 
  14. ' concerns a group of single-celled creatures (represented by an O 
  15. ' The "game" is played on a board the size of the screen (40x24  
  16. ' characters).  Change the values of W and H to make the screen  
  17. ' larger or smaller (in this case, only smaller).  Each square has 
  18. ' 2 possible states - alive or dead.  Every "turn" the computer
  19. ' works out which squares are alive or dead using the following
  20. ' rules...  (Neighbours being the eight cells surrounding the
  21. ' cell in question,  as opposed to a popular Australian Soap Opera)
  22. '
  23. ' A dead cell becomes alive if it has three live neighbours (the 
  24. ' cells have 3 sexes, not 2)   
  25. '
  26. ' A cell with four or more live neighbours suffocates (Ha ha ha!)
  27. '
  28. ' A cell with no live neighbours (or only 1), dies of exposure and 
  29. ' loneliness (Awwww!)
  30. '
  31. ' All you have to do is set up the lines of cells by inputting them  
  32. ' at the prompt.  A space is a dead cell and any other character is a  
  33. ' live cell. 
  34. '
  35. ' Examples :   *****    : This one gives you a 'blinker' (after a couple 
  36. '                         of generations it repeats a pattern forever)               
  37. '  
  38. '              *        : I could swear this one makes faces at me!!!  
  39. '              * 
  40. '       |      * 
  41. '      \|/     * 
  42. '       V      ... 
  43. '   As far down as it will go
  44. '  
  45. '              **** *  * 
  46. '              *  * **** 
  47. '
  48. ' You can have really big starting thingies if you can be bothered to
  49. ' type them in.
  50. '
  51. ' Once you have pressed return on a blank line, the game kicks in.  It 
  52. ' draws the cells on the screen, then there is a slight pause while it 
  53. ' works out births and deaths.  then the screen redraws.  You can leave
  54. ' it running for hours!  Sometimes the game gets caught in a perpetual 
  55. ' loop, and sometimes there can seem to be a form of intelligence behind 
  56. ' the "random" patterns.  Sometimes they all die and you are left with 
  57. ' a blank screen!  If this happens, you have to hold down the mouse button 
  58. ' or use CTRL-C to quit. 
  59. '
  60. ' Oh, and hold down the left mouse button to quit the program  
  61. '  
  62. '
  63. Set Buffer 16
  64. ' Increase the variable buffer as a lot of data is required
  65. '
  66. Gosub SETUP : Rem Set up the screen etc. 
  67. '
  68. W=40 : H=24 : Rem Screen(W)IDTH and(H)EIGHT
  69. '
  70. Add W,-1 : Add H,-1
  71. ' Don't let graphics overflow the screen and make it scroll
  72. '
  73. Dim A(W+2,H+2),B(W+2,H+2)
  74. ' 2 arrays to hold the current gameboard and the old one 
  75. '
  76. '
  77. Print "Input Lines of cells.  Hit Return alone to finish"
  78. L=1
  79. ' L holds the number of lines inputted so far
  80. '
  81. INPLINES:
  82. Input A$ : Inc L
  83. ' Take the inout and increase L
  84. '
  85. If A$="" Then Goto SHIFTPATTERN
  86. ' When the user has finished skip out of this bit
  87. '
  88. If ML<Len(A$)
  89.    ML=Len(A$)
  90. End If 
  91. ' Get longest line 
  92. '
  93. If Len(A$)>W
  94.    Print "Too long!"
  95.    Goto INPLINES
  96. End If 
  97. ' Don't let the user input a line that is too long 
  98. '
  99. If L>H
  100.    Goto SHIFTPATTERN
  101. End If 
  102. ' If there are enough lines, we can get going
  103. '
  104. For K=1 To Len(A$)
  105.    C$=Mid$(A$,K,1)
  106.    If C$<>" "
  107.       A(K,L)=1
  108.    End If 
  109. Next K
  110. ' Sort out the data for the line.  A space is a gap, anything else is a
  111. ' living cell
  112. '
  113. Goto INPLINES
  114. ' And loop 
  115. '
  116. SHIFTPATTERN:
  117. SW=Int((W-ML-1)/2)
  118. SH=Int(H-L-1)/2
  119. For K=1 To ML
  120.    For J=1 To L
  121.       B(K+SW,J+SH)=A(K,J)
  122.    Next J
  123. Next K
  124. ' This little For.. Next loop centres the longest line so that the screen
  125. ' display is also central. 
  126. '
  127. Curs Off 
  128. ' Get rid of the input cursor
  129. '
  130. Ink 0 : Bar 0,0 To 320,100 : Ink 1
  131. Home : Centre "��� AmigaLife v1.00 ï¿½ï¿½ï¿½"
  132. ' Clear INPUT text and replace it with a message.
  133. '
  134. Gosub DISPLAYARRAYB
  135. ' Display the array, today, Wha-hey!  No way!
  136. '
  137. Repeat 
  138.    ' Do a generation from b to a
  139.    '
  140.    P0P=0
  141.    For K=1 To H
  142.       For J=1 To W
  143.          N=0 : C=B(J,K) : Rem Zero neighbour count, save cell value
  144.          N=B(J-1,K-1)+B(J,K-1)+B(J+1,K-1)+B(J-1,K)+B(J+1,K)+B(J-1,K+1)+B(J,K+1)+B(J+1,K+1)
  145.          ' Count up neighbours
  146.          Gosub _DECISION
  147.          A(J,K)=NXT : Inc P0P : Rem put next generation into A 
  148.       Next J
  149.    Next K
  150.    '
  151.    If P0P=0 Then Stop 
  152.    '
  153.    Gosub DISPLAYARRAYA
  154.    '
  155.    ' Now put generation into b
  156.    '
  157.    P0P=0
  158.    For K=1 To H
  159.       For J=1 To W
  160.          N=0 : C=B(J,K) : Rem Zero neighbour count, save cell value
  161.          N=A(J-1,K-1)+A(J,K-1)+A(J+1,K-1)+A(J-1,K)+A(J+1,K)+A(J-1,K+1)+A(J,K+1)+A(J+1,K+1)
  162.          ' Count up neighbours
  163.          Gosub _DECISION
  164.          B(J,K)=NXT : Inc P0P : Rem put next generation into b 
  165.       Next J
  166.    Next K
  167.    '
  168.    If P0P=0 Then Stop 
  169.    '
  170.    Gosub DISPLAYARRAYB
  171.    '
  172. Until Mouse Key<>0
  173. Cls : Cdown : Cdown : Cdown : Cdown : Cdown 
  174. Centre "�� AmigaLife v1.00 ï¿½ï¿½ï¿½"
  175. Cdown : Cdown : Cdown : Cdown 
  176. Centre "Another great program from..."
  177. Cdown : Cdown : Cdown : Cdown 
  178. Centre "RipperSoft"
  179. Cdown : Cdown : Cdown : Cdown 
  180. Centre "Press Mouse button to return to editor"
  181. Wait 50
  182. Repeat 
  183. Until Mouse Key<>1
  184. Proc CHUCKRAINBOW
  185. Fade 2
  186. Edit 
  187. '
  188. ' What's wrong with subroutines?  Nobody uses them anymore!  It saves you
  189. ' from having to define every variable as global at the start of the 
  190. ' program.  OK... OK... It's based on 1983 code.  That's why it uses Goto
  191. ' and Gosub etc. 
  192. '
  193. ' SORRY!  It took long enough removing the line numbers :-)
  194. '
  195. DISPLAYARRAYA:
  196. Home : Cdown : Cdown 
  197. ' Home cursor, using highly technical cursor moving technique  
  198. '
  199. For K=1 To H
  200.    For J=1 To W
  201.       If A(J,K)=1 Then Print "O"; Else Print " ";
  202.    Next J
  203.    Print 
  204. Next K
  205. ' You can change the O to whatever you want.  For example, *, %, @, # all
  206. ' look quite good. Who needs AGA when you've got the letter O? 
  207. ' Don't forget to chnage it in the other display subroutine, though (unless
  208. ' you want to animate the cells!  There's an idea!!
  209. '
  210. Return 
  211. '
  212. DISPLAYARRAYB:
  213. Home : Cdown : Cdown 
  214. For K=1 To H
  215.    For J=1 To W
  216.       If B(J,K)=1 Then Print "O"; Else Print " ";
  217.    Next J
  218.    Print 
  219. Next K
  220. Return 
  221. '
  222. _DECISION:
  223. If N<2 or N>3 Then NXT=0 : Return 
  224. ' Death by loneliness or overcrowding
  225. If C=0 and N=3 Then NXT=1 : Return 
  226. ' Birth
  227. NXT=C : Rem No change
  228. Return 
  229. '
  230. SETUP:
  231. Screen Open 0,320,256,2,Lowres
  232. Flash Off : Wait Vbl 
  233. Palette $0,$FFF
  234. Hide On : Wait Vbl 
  235. Set Rainbow 0,0,300,"","","(20,1,1)"
  236. Rainbow 0,56,50,255
  237. Text 10,220,"Adapted for AMOS by Mike Richmond"
  238. Text 10,235,"Hold down left mouse button to quit"
  239. '
  240. 'A rainbow jazzes up the 2 colour screen a little! 
  241. '
  242. Return 
  243. Procedure CHUCKRAINBOW
  244.    For X=255 To 0 Step -2
  245.       Rainbow 0,56,40,X
  246.       Wait 1
  247.    Next 
  248. End Proc